home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / amsf20.zip / AMST1.FOR < prev    next >
Text File  |  1992-01-06  |  1KB  |  49 lines
  1.       PROGRAM AMST1
  2.       IMPLICIT INTEGER*4(I-N)
  3. C
  4. C ... AMS TEST PROGRAM 1
  5. C
  6.       COMMON MAVAIL,IA(30000)
  7.       MAVAIL = 30000
  8. C ... OPEN DATA BASE
  9.       CALL DBOPEN(1,'DB1.DAT','NEW')
  10. C ... DEFINE MATRICES
  11.       CALL DEFINE(1,'MATA',0,1,3,3,0,LOC)
  12.       CALL DEFINE(1,'BCDE',6,0,5,5,1,LOC)
  13.       CALL DEFINE(1,'SSSS',0,2,7,6,0,LOC)
  14.       CALL DEFINE(1,'QQQ',5,1,6,4,0,LOC)
  15.       CALL DEFINE(1,'DFGH',0,1,10,10,2,LOC)
  16.       CALL DEFINE(1,'A',0,1,10,10,2,LOC)
  17. C ... LOOK DIRECTORY
  18.       CALL DIR(0)
  19. C ... SORT DIRECTORY
  20.       CALL DSORT
  21.       CALL DIR(0)
  22. C ... DEFINE NEW MATRICES
  23.       CALL DEFINE(1,'MATB',1,1,5,5,0,LOC)
  24.       CALL DEFINE(1,'MATC',1,1,5,5,0,LOC)
  25.       CALL DEFINE(1,'MATD',1,1,5,5,0,LOC)
  26.       CALL DIR(0)
  27. C ... SAVE MATRIX AND RENAME
  28.       DO 10 I=1,6
  29. 10    CALL SAVE(1,'BCDE',I)
  30.       DO 20 I=1,5
  31. 20    CALL SAVE(1,'QQQ',I)
  32.       CALL RENAME(1,'BCDE','NEW1')
  33.       CALL RENAME(1,'QQQ','NEW2')
  34. C ... LOOK DIRECTORY AGAIN
  35.       CALL DIR(0)
  36. C ... DELETE MATRICES
  37.       CALL DELETE(1,'DFGH')
  38.       CALL DIR(0)
  39.       CALL DELETE(1,'SSSS')
  40. C ... LOOK DIRECTORY
  41.       CALL DIR(0)
  42. C ... DELETE ALL INCORE MATRIX
  43.       CALL DELALL(1)
  44.       CALL DIR(0)
  45. C ... CLOSE DATA BASE
  46.       CALL DBCLOS(1,'SAVE')
  47.       STOP 'DONE.'
  48.       END
  49.